home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 January / Macworld (1998-01).dmg / Shareware World / Comms & Internet / HTML mode 2.0 etc. / hctsmsl.tcl < prev    next >
Text File  |  1997-09-22  |  34KB  |  1,026 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  HTML and CSS mode - tools for editing Cascading Style Sheets
  4.  # 
  5.  #  FILE: "hctsmsl.tcl"
  6.  #                                    created: 97-03-08 19.32.58 
  7.  #                                last update: 97-09-21 19.12.09 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <jl@theophys.kth.se>
  10.  #     www: <http://bach.theophys.kth.se/~jl/Alpha.html>
  11.  #  
  12.  # Version: 2.0 and 1.0
  13.  # 
  14.  # Copyright 1996, 1997 by Johan Linde
  15.  #  
  16.  # This software may be used freely, and distributed freely, as long as the 
  17.  # receiver is not obligated in any way by receiving it.
  18.  #  
  19.  # If you make improvements to this file, please share them!
  20.  # 
  21.  # ###################################################################
  22.  ##
  23.  
  24. proc hctsmsl.tcl {} {}
  25.  
  26. # Units allowed for length.
  27. set cssUnits {em ex px pt cm mm in pc}
  28.  
  29. # These properties can take a number as value.
  30. set cssNumbers {line-height}
  31.  
  32. # These properties can take length values.
  33. set cssLengths {font-size line-height background-position word-spacing letter-spacing
  34. text-indent margin-top margin-right margin-bottom margin-left padding-top padding-right
  35. padding-bottom padding-left border-top-width border-right-width border-bottom-width
  36. border-left-width border-width width height}
  37.  
  38. # These properties can take percentage values.
  39. set cssPercentage {font-size line-height background-position vertical-align text-indent
  40. margin-top margin-right margin-bottom margin-left padding-top padding-right
  41. padding-bottom padding-left width}
  42.  
  43. # These properties can take URL values.
  44. set cssURLs {background-image list-style-image @import}
  45.  
  46. # These properties can take color values.
  47. set cssColors {color background-color border-color}
  48.  
  49. # These properties can take any value.
  50. set cssAny {font-family}
  51.  
  52. # Groups of properties for different dialogs.
  53. set cssGroup(font) {font-style font-variant font-weight font-size line-height font-family}
  54. set cssGroup(background) {background-color background-image background-repeat
  55. background-attachment background-position}
  56. set cssGroup(text) {word-spacing letter-spacing text-decoration vertical-align
  57. text-transform text-align text-indent}
  58. set cssGroup(margin) {margin-top margin-right margin-bottom margin-left}
  59. set cssGroup(padding) {padding-top padding-right padding-bottom padding-left}
  60. set cssGroup(border) {border-width border-style border-color}
  61. set cssGroup(border-width) {border-top-width border-right-width border-bottom-width
  62. border-left-width}
  63. set cssGroup(size) {width height}
  64. set cssGroup(Display) {display white-space}
  65. set cssGroup(list-style) {list-style-type list-style-image list-style-position}
  66.  
  67. # These of the above groups are shorthands.
  68. set cssShorthands {font background margin padding border border-width list-style}
  69.  
  70. # Possible values of the css properties.
  71. set cssProperty(font-family) {serif sans-serif cursive fantasy monospace}
  72. set cssProperty(font-style) {italic oblique normal}
  73. set cssProperty(font-variant) {small-caps normal}
  74. set cssProperty(font-weight) {bold bolder lighter 100 200 300 400 500 600 700 800 900 normal}
  75. set cssProperty(font-size) {larger smaller xx-small x-small small medium large x-large xx-large}
  76. set cssProperty(line-height) {normal}
  77. set cssProperty(background-color) {transparent}
  78. set cssProperty(background-image) {none}
  79. set cssProperty(background-repeat) {repeat-x repeat-y no-repeat repeat}
  80. set cssProperty(background-attachment) {fixed scroll}
  81. set cssProperty(background-position) {{top center bottom} {left center right}}
  82. set cssProperty(word-spacing) {normal}
  83. set cssProperty(letter-spacing) {normal}
  84. set cssProperty(text-decoration) {none {underline overline line-through blink}}
  85. set cssProperty(vertical-align) {sub super top text-top middle bottom text-bottom baseline}
  86. set cssProperty(text-transform) {capitalize uppercase lowercase none}
  87. set cssProperty(text-align) {left right center justify}
  88. set cssProperty(margin-top) {auto}
  89. set cssProperty(margin-right) {auto}
  90. set cssProperty(margin-bottom) {auto}
  91. set cssProperty(margin-left) {auto}
  92. set cssProperty(border-width) {thin medium thick}
  93. set cssProperty(border-top-width) {thin medium thick}
  94. set cssProperty(border-right-width) {thin medium thick}
  95. set cssProperty(border-bottom-width) {thin medium thick}
  96. set cssProperty(border-left-width) {thin medium thick}
  97. set cssProperty(border-style) {dotted dashed solid double groove ridge inset outset none}
  98. set cssProperty(width) {auto}
  99. set cssProperty(height) {auto}
  100. set cssProperty(float) {left right none}
  101. set cssProperty(clear) {left right both none}
  102. set cssProperty(display) {block inline list-item none}
  103. set cssProperty(white-space) {pre nowrap normal}
  104. set cssProperty(list-style-type) {disc circle square decimal lower-roman upper-roman lower-alpha
  105. upper-alpha none}
  106. set cssProperty(list-style-image) {none}
  107. set cssProperty(list-style-position) {inside outside}
  108.  
  109.  
  110. proc cssGetHtmlWords {} {
  111.     global cssHtmlWords htmlElemAttrOptional1 htmlElemAttrOptional3 HTMLmodeVars htmlModeIsLoaded
  112.     if {![info exists htmlModeIsLoaded]} {
  113.         return $cssHtmlWords
  114.     } else {
  115.         catch {unset cssHtmlWords}
  116.         return [array names htmlElemAttrOptional[set HTMLmodeVars(htmlPackageToUse)]]
  117.     }    
  118. }
  119.  
  120. # ◊◊◊◊ Change below for new system §19 ◊◊◊◊ #
  121.  
  122. # Word completion
  123. proc cssWordComplete {} {
  124.     global cssLengths cssPercentage cssColors cssURLs cssAny cssGroup cssProperty
  125.     global HTMLmodeVars
  126.     
  127.     set allCss [removeDups [concat $cssLengths $cssPercentage $cssColors $cssURLs $cssAny \
  128.     [array names cssGroup] [array names cssProperty] border-left border-top border-bottom border-right]]
  129.     foreach p {size text Display} {
  130.         set allCss [lreplace $allCss [set w [lsearch $allCss $p]] $w]
  131.     }
  132.     set matches ""
  133.     # Between {}?
  134.     set thepos [getPos]
  135.     if {$thepos == [maxPos]} {set thepos [expr [maxPos] - 1]}
  136.     if {[catch {matchIt "\}" $thepos} bpos]} {
  137.         set allHtmlWords [cssGetHtmlWords]
  138.         set pos [getPos]
  139.         backwardWord
  140.         set word [string toupper [getText [getPos] $pos]]
  141.         foreach p $allHtmlWords {
  142.             if {[string match $word* $p]} {lappend matches $p}
  143.         }
  144.         if {![llength $matches]} {
  145.             select [getPos] $pos
  146.         } else {
  147.             replaceText [getPos] $pos [largestPrefix $matches]
  148.         }
  149.         return
  150.     }
  151.     # Get current word
  152.     if {[catch {search -s -f 0 -m 0 -r 1 {[\{;: \t\r]} [expr [getPos] - 1]} wpos]} {set wpos "0 0"}
  153.     set wpos [lindex $wpos 1]
  154.     set word [getText $wpos [getPos]]
  155.     # Before or after :?
  156.     if {[catch {search -s -f 0 -m 0 -r 0 {;} [expr [getPos] - 1]} spos] || [lindex $spos 0] < $bpos} {set spos 0}
  157.     set spos [lindex $spos 0]
  158.     if {[catch {search -s -f 0 -m 0 -r 0 {:} [getPos]} cpos] || [lindex $cpos 0] < $bpos} {set cpos 0}
  159.     set cpos [lindex $cpos 0]
  160.     if {$spos < $cpos} {
  161.         # After colon
  162.         if {[catch {search -s -f 0 -m 0 -r 1 {[; \t\r]} $cpos} w2pos]} {set w2pos 0}
  163.         set pword [getText [lindex $w2pos 1] $cpos]
  164.         if {[lsearch -exact $cssURLs $pword] >= 0 || [string match "url(*" $word]} {
  165.             set matchWords $HTMLmodeVars(URLs)
  166.             incr wpos 4
  167.             set word [string trimleft [string range $word 4 end] \"]
  168.             set isURL 1
  169.         } else {
  170.             set matchWords [eval concat $cssProperty($pword)]
  171.             set isURL 0
  172.         }
  173.         foreach p $matchWords {
  174.             if {[string match $word* $p]} {lappend matches $p}
  175.         }
  176.         if {![llength $matches]} {
  177.             select $wpos [getPos]
  178.         } else {
  179.             replaceText $wpos [getPos] [lindex {"" "\""} $isURL][largestPrefix $matches]
  180.         }
  181.     } else {
  182.         # Before colon
  183.         foreach p $allCss {
  184.             if {[string match $word* $p]} {lappend matches $p}
  185.         }
  186.         if {![llength $matches]} {
  187.             select $wpos [getPos]
  188.         } else {
  189.             set word [largestPrefix $matches]
  190.             if {[llength $matches] == 1} {
  191.                 append word ": "
  192.                 set backTwo 0
  193.                 if {[lsearch -exact $cssURLs [string trimright $word ": "]] >= 0} {
  194.                     append word "url(\"\")"
  195.                     set backTwo 1
  196.                 }
  197.             }
  198.             replaceText $wpos [getPos] $word
  199.             if {$backTwo} {goto [expr [getPos] - 2]}
  200.         }
  201.     }    
  202. }
  203.  
  204. # ◊◊◊◊ end changing for new system §19 ◊◊◊◊ #
  205.  
  206. # CSS properties dialog.
  207. proc cssDialog {group} {
  208.     global cssGroup cssProperty cssAny cssURLs cssLengths cssPercentage cssColors cssUnits
  209.     global htmluserColors htmlColorName basicColors HTMLmodeVars cssShorthands mode cssNumbers
  210.     
  211.     if {$mode == "HTML" && ![htmlIsInContainer STYLE]} {
  212.         beep
  213.         message "Current position is not inside STYLE tags."
  214.         return
  215.     }
  216.     # Fins where to insert text.
  217.     set gpos [getPos]
  218.     if {$gpos > 0} {incr gpos -1}
  219.     if {[catch {search -s -f 0 -m 0 -r 1 "\{" $gpos} lbrace]} {set lbrace 0; set noleft 1}
  220.     set lbrace [expr [lindex $lbrace 0] + 1]
  221.     if {[catch {search -s -f 0 -m 0 -r 1 "\}" $gpos} rbrace]} {set rbrace 0}
  222.     set rbrace [expr [lindex $rbrace 0] + 1]
  223.     if {([info exists noleft] || $rbrace > $lbrace) && $group != "@import"} {alertnote "Incorrect position to insert properties."; return}
  224.     if {[catch {search -s -f 0 -m 0 -r 1 "\;" $gpos} semi] || [lindex $semi 0] < $lbrace} {set semi 0}
  225.     set semi [expr [lindex $semi 0] + 1]
  226.     if {$group != "@import" && ($lbrace > 1 || $semi > 1)} {goto [expr $lbrace > $semi ? $lbrace : $semi]}
  227.  
  228.     # define colors
  229.     set htmlColors [lsort [array names htmluserColors]]
  230.      append htmlColors " - " $basicColors
  231.     
  232.     # urls
  233.     set URLs $HTMLmodeVars(URLs)
  234.  
  235.     # these fit in half the size of the dialog window
  236.     set halfIsEnough {font-style font-variant font-weight text-transform text-align white-space}
  237.     
  238.     # These needs more space
  239.     set dw 0
  240.     if {$group == "background" || $group == "border-width" || $group == "list-style"} {set dw 40}
  241.     # obtain all props for this group
  242.     if {[info exists cssGroup($group)]} {
  243.         set props $cssGroup($group)
  244.     } else {
  245.         set props $group
  246.     }
  247.     
  248.     # build the dialog
  249.     set invalidInput 1
  250.     set short 1
  251.     set allvalues 0
  252.     set val [cssGetProperties $group]
  253.     if {[info exists errorText] && ![htmlErrorWindow "$group not well-defined" $errorText 1]} {return}
  254.     while {$invalidInput} {
  255.         while {1} {
  256.             if {$group == "@import"} {
  257.                 set htxt "Import Style Sheet"
  258.             } else {
  259.                 set htxt "[string toupper [string index $group 0]][string range $group 1 end] properties"
  260.             }
  261.             set box "-t [list $htxt] 120 10 450 25"
  262.             set fileIndex ""
  263.             set colorIndex ""
  264.             set proptypes ""
  265.             set hpos 35
  266.             set ind 2
  267.             set wpos 10
  268.             foreach p $props {
  269.                 if {[lsearch -exact $halfIsEnough $p] < 0 || $wpos > 235} {
  270.                     if {$wpos > 10} {set wpos 10; incr hpos 30}
  271.                 }
  272.                 if {$p != "@import"} {lappend box -t ${p}: $wpos $hpos [expr $wpos + 110 + $dw] [expr $hpos + 15]}
  273.                 incr wpos 120
  274.                 incr wpos $dw
  275.                 if {[info exists cssProperty($p)]} {
  276.                     # A list of choices
  277.                     set pr $cssProperty($p)
  278.                     # special case with background-position and text-decoration
  279.                     if {$p == "background-position" || $p == "text-decoration"} {
  280.                         set pr1 [lindex $pr 0]
  281.                         if {[llength $pr1] > 1} {
  282.                             lappend box -m [concat [list [lindex $val $ind] "No value"] $pr1] \
  283.                             $wpos $hpos [expr $wpos + 95] [expr $hpos + 15]
  284.                         } else {
  285.                             lappend box -c $pr1 [lindex $val $ind] $wpos $hpos [expr $wpos + 95] [expr $hpos + 15]
  286.                         }
  287.                         incr wpos 105
  288.                         incr ind
  289.                         set pr [lindex $pr 1]
  290.                         lappend proptypes $p choices
  291.                     }
  292.                     set n 1
  293.                     # four times for text-decoration and border-style
  294.                     if {$p == "text-decoration" || $group == "border-style"} {set n 4}
  295.                     for {set i 0} {$i < $n} {incr i} {
  296.                         if {$wpos > 355 + $dw} {
  297.                             set wpos [expr 130 + $dw]
  298.                             incr hpos 30
  299.                         }
  300.                         if {[llength $pr] > 1} {
  301.                             lappend box -m [concat [list [lindex $val $ind] "No value"] $pr] \
  302.                             $wpos $hpos [expr $wpos + 95] [expr $hpos + 15]
  303.                         } else {
  304.                             lappend box -c $pr [lindex $val $ind] $wpos $hpos [expr $wpos + 95] [expr $hpos + 15]
  305.                         }
  306.                         incr wpos 105
  307.                         incr ind
  308.                         lappend proptypes $p choices
  309.                     }
  310.                 }
  311.                 set l [lsearch -exact $cssLengths $p]
  312.                 set pr [lsearch -exact $cssPercentage $p]
  313.                 if { $l >= 0 || $pr  >= 0 } {
  314.                     # Length or percentage
  315.                     set n 1
  316.                     # twice for background-position
  317.                     if {$p == "background-position"} {set n 2}
  318.                     for {set i 0} {$i < $n} {incr i} {
  319.                         if {$wpos > 335 + $dw} {
  320.                             set wpos [expr 130 + $dw]
  321.                             incr hpos 30
  322.                         }
  323.                         set units ""
  324.                         if {$l >= 0} {set units $cssUnits}
  325.                         if {$pr >= 0} {lappend units %}
  326.                         set uw 110
  327.                         if {[lsearch -exact $cssNumbers $p] >= 0} {set units "{No unit} $units"; set uw 160}
  328.                         lappend box -e [lindex $val $ind] $wpos $hpos [expr $wpos + 50] [expr $hpos + 15]
  329.                         lappend box -m [concat [list [lindex $val [expr $ind + 1]]] $units] \
  330.                         [expr $wpos + 60] $hpos [expr $wpos + $uw] [expr $hpos + 15]
  331.                         incr wpos 120
  332.                         incr ind 2
  333.                         lappend proptypes $p number
  334.                     }
  335.                     set wpos 10
  336.                     incr hpos 30
  337.                 }
  338.                 if {[lsearch -exact $cssAny $p] >= 0} {
  339.                     # Any value
  340.                     if {$wpos > 10} {set wpos 10; incr hpos 30}
  341.                     lappend box -e [lindex $val $ind] 10 $hpos 450 [expr $hpos + 15]
  342.                     incr ind
  343.                     set wpos 10
  344.                     incr hpos 30
  345.                     lappend proptypes $p any
  346.                 }
  347.                 if {[lsearch -exact $cssColors $p] >=0 } {
  348.                     # color
  349.                     set n 1
  350.                     # four times for border-color
  351.                     if {$group == "border-color"} {set n 4}
  352.                     for {set i 0} {$i < $n} {incr i} {
  353.                         if {$wpos > 130} {set wpos 10; incr hpos 30}
  354.                         lappend box -e [lindex $val $ind] 130 $hpos 200 [expr $hpos + 15] \
  355.                         -m [concat [list [lindex $val [expr $ind + 1]] {No value}] $htmlColors] \
  356.                         210 $hpos 340 [expr $hpos + 15] \
  357.                         -b "New Color…" 350 $hpos 450 [expr $hpos + 20]
  358.                         incr ind 3
  359.                         lappend colorIndex [expr $ind - 1]
  360.                         set wpos 10
  361.                         incr hpos 40
  362.                         lappend proptypes $p color
  363.                     }
  364.                 }
  365.                 if {[lsearch -exact $cssURLs $p] >= 0} {
  366.                     # URL
  367.                     if {$wpos > 130} {set wpos 10; incr hpos 30}
  368.                     lappend box -e [lindex $val $ind] 120 $hpos 450 [expr $hpos + 15] \
  369.                     -m [concat [list [lindex $val [expr $ind + 1]] {No value}] $URLs] \
  370.                     120 [expr $hpos + 25] 450 [expr $hpos + 35] \
  371.                     -b "File…" 10 [expr $hpos + 20] 70 [expr $hpos + 40]
  372.                     incr ind 3
  373.                     lappend fileIndex [expr $ind - 1]
  374.                     set wpos 10
  375.                     incr hpos 50
  376.                     lappend proptypes $p url
  377.                 }
  378.                 if {[string match "*left*" $p]} {
  379.                     if {$wpos > 130} {set wpos 10; incr hpos 30}
  380.                     lappend box -r "Set all values individually" $allvalues 10 $hpos 300 [expr $hpos + 15]
  381.                     lappend box -r "Add missing values automatically if possible" [expr !$allvalues] 10 [expr $hpos + 20] 350 [expr $hpos + 35]
  382.                     set allValIndex $ind
  383.                     incr ind 2
  384.                     set wpos 10
  385.                     incr hpos 40
  386.                     lappend proptypes $p allval
  387.                 }
  388.             }
  389.             if {$wpos > 10} {incr hpos 20}
  390.             if {[lsearch -exact $cssShorthands $group] >= 0} {
  391.                 lappend box -c "Use shorthand form if possible" $short 10 $hpos 250 [expr $hpos + 15]
  392.                 incr hpos 20
  393.                 set shortIndex $ind
  394.             }
  395.             set val [eval [concat dialog -w [expr 460 + $dw] -h [expr $hpos + 50] \
  396.             -b OK 20 [expr $hpos + 20]  85 [expr $hpos + 40] \
  397.             -b Cancel 110 [expr $hpos + 20] 175 [expr $hpos + 40] $box]]
  398.             if {[info exists shortIndex]} {set short [lindex $val $shortIndex]}
  399.             if {[info exists allValIndex]} {set allvalues [lindex $val $allValIndex]}
  400.             # OK clicked?
  401.             if {[lindex $val 0]} {break}
  402.             # Cancel clicked?
  403.             if {[lindex $val 1]} {return}
  404.             # File button clicked?
  405.             foreach fl $fileIndex {
  406.                 if {[lindex $val $fl] && [set newFile [htmlGetFile]] != ""} {
  407.                     set URLs $HTMLmodeVars(URLs)
  408.                     set val [lreplace $val [expr $fl - 1] [expr $fl - 1] [lindex $newFile 0]]
  409.                 }
  410.             }
  411.             # Color button clicked?
  412.             foreach cl $colorIndex {
  413.                 if {[lindex $val $cl] && [set newColor [htmlAddNewColor]] != ""} {
  414.                     set htmlColors [concat [list $newColor] $htmlColors]
  415.                     set val [lreplace $val [expr $cl -1] [expr $cl - 1] "$newColor"]
  416.                 }
  417.             }
  418.         }
  419.         
  420.         # Find indentation.
  421.         set indent ""
  422.         if {![catch {matchIt "\}" [getPos]} pos]} {
  423.             regexp {^[ \t]*} [getText [lineStart $pos] $pos] indent
  424.         }
  425.         # Put it all together.
  426.         set j 2
  427.         set prevprop ""
  428.         set proptext ""
  429.         set errtext ""
  430.         set tmptext ""
  431.         for {set i 0} {$i < [llength $proptypes]} {incr i 2} {
  432.             set prop [lindex $proptypes [expr $i + 1]]
  433.             if {$prevprop != [set pr [lindex $proptypes $i]]} {
  434.                 if {$tmptext != ""} {
  435.                     if {$prevprop == "text-decoration"} {
  436.                         if {[lindex $tmptext 0] == "1"} {
  437.                             set tmptext " none"
  438.                         } elseif {$tmptext != " 0"} {
  439.                             set tmptext " [removeDups [lrange $tmptext 1 end]]"
  440.                         }
  441.                     } else {
  442.                         set tmptext " [lindex $tmptext 0]"
  443.                     }
  444.                     if {$tmptext != " 0"} {
  445.                         if {[info exists important($prevprop)] || [info exists important($group)]} {append tmptext " ! important"}
  446.                         append proptext "\;\r$indent\t$prevprop:$tmptext"
  447.                     }
  448.                 }
  449.                 set prevprop $pr
  450.                 set tmptext ""
  451.             }
  452.             switch $prop {
  453.                 choices {
  454.                     if {[llength $cssProperty($pr)] == 1} {
  455.                         if {[lindex $val $j]} {
  456.                             append tmptext " $cssProperty($pr)"
  457.                         }
  458.                     } elseif {[set c [lindex $val $j]] != "No value"} {
  459.                         append tmptext " $c"
  460.                     }
  461.                     incr j
  462.                 }
  463.                 number {
  464.                     if {[set c [string trim [lindex $val $j]]] != ""} {
  465.                         if {![catch {cssCheckNumber $pr $c [lindex $val [expr $j + 1]]} c]} {
  466.                             append tmptext " $c"
  467.                         } else {
  468.                             lappend errtext "$pr: $c"
  469.                         }
  470.                     }
  471.                     incr j 2
  472.                 }
  473.                 any {
  474.                     if {[set c [string trim [lindex $val $j]]] != ""} {
  475.                         append tmptext ", $c"
  476.                     }
  477.                     incr j
  478.                 }
  479.                 color {
  480.                     if {[set ctxt [string trim [lindex $val $j]]] != ""} {
  481.                         if {[set col [cssCheckColorNumber $ctxt]] == 0} {
  482.                             lappend errtext "$pr: $ctxt is not a valid color number."
  483.                         } else {
  484.                             append tmptext " $col"
  485.                         }
  486.                     } elseif {[set cval [lindex $val [expr $j + 1]]] != "No value"} {
  487.                         if {[info exists htmluserColors($cval)]} {
  488.                             append tmptext " $htmluserColors($cval)"
  489.                         }
  490.                         if {[info exists htmlColorName($cval)]} {
  491.                             append tmptext " $htmlColorName($cval)"
  492.                         }
  493.                     }
  494.                     incr j 3
  495.                 }
  496.                 url {
  497.                     if {[set turl [string trim [lindex $val $j]]] != ""} {
  498.                         append tmptext " url(\"[htmlURLescape2 $turl]\")"
  499.                         htmlAddToCache URLs $turl
  500.                     } elseif {[set murl [lindex $val [expr $j + 1]]] != "No value"} {
  501.                         append tmptext " url(\"[htmlURLescape2 $murl]\")"
  502.                     }
  503.                     incr j 3
  504.                 }
  505.                 allval {
  506.                     incr j 2
  507.                 }
  508.             }
  509.         }
  510.         if {$tmptext != ""} {
  511.             if {$prevprop == "background-position"} {
  512.                 if {[regexp {^[a-z]+$} [lindex $tmptext 0]]} {
  513.                     set tp ""
  514.                     foreach tm $tmptext {
  515.                         if {[regexp {^[a-z]+$} $tm]} {
  516.                             lappend tp $tm
  517.                         }
  518.                     }
  519.                     set tmptext " $tp"
  520.                 }
  521.             } elseif {$prevprop == "font-family"} {
  522.                 set tmptext [string trim $tmptext ,]
  523.                 if {[lsearch -exact $cssProperty(font-family) [set first [string trim [lindex $tmptext 0] ,]]] >= 0
  524.                 && [llength $tmptext] > 1} {
  525.                     set tmptext " [lrange $tmptext 1 end], $first"
  526.                 }
  527.             } elseif {$prevprop != "border-style" && $prevprop != "border-color"} {
  528.                 set tmptext " [lindex $tmptext 0]"
  529.             }
  530.             if {[info exists important($prevprop)] || [info exists important($group)]} {append tmptext " ! important"}
  531.             append proptext "\;\r$indent\t$pr:$tmptext"
  532.         }
  533.         set proptext [string trimleft $proptext "\;"]
  534.         if {![llength $errtext]} {
  535.             set invalidInput 0
  536.             if {[info exists allValIndex] && !$allvalues} {set proptext [cssAddMissingValues $group $proptext $indent]}
  537.             if {[info exists shortIndex] && $short} {set proptext [cssMakeShort $group $proptext $indent]}
  538.         } else {
  539.             htmlErrorWindow "Invalid input" $errtext
  540.         }
  541.         
  542.     }
  543.     # Special fixes for @import
  544.     if {$group == "@import"} {
  545.         regexp {^[ \t]*} [getText [lineStart [getPos]] [getPos]] indent
  546.         set proptext [string trimleft $proptext ";"]
  547.         regsub "\t+" $proptext "$indent" proptext
  548.         regsub "@import:" $proptext "@import" proptext
  549.     }
  550.     set len 0
  551.     if {$proptext != ""} {
  552.         set ps [getPos]
  553.         insertText "$proptext\;"
  554.         set len [expr [getPos] - $ps]
  555.     }
  556.     set removePos0 [lsort -integer -decreasing $removePos0]
  557.     set removePos1 [lsort -integer -decreasing $removePos1]
  558.     # Check for overlapping positions.
  559.     set r0 [maxPos]
  560.     for {set i 0} {$i < [llength $removePos1]} {incr i} {
  561.         set r00 [lindex $removePos0 $i]
  562.         set r11 [lindex $removePos1 $i]
  563.         if {$r11 > $r0} {set r11 $r0}
  564.         if {$r11 > $r00} {lappend rem [list $r00 $r11]}
  565.         set r0 $r00
  566.     }
  567.     foreach r $rem {
  568.         set xpos 0
  569.         if {[set pos1 [lindex $r 0]] >= $ps} {set xpos $len}
  570.         deleteText [expr $pos1 + $xpos] [expr [lindex $r 1] + $xpos]
  571.     }
  572. }
  573.  
  574. # Add missing values to top, right, bottom, left properties.
  575. proc cssAddMissingValues {group text indent} {
  576.     global cssGroup
  577.     set tmp [split $text "\r"]
  578.     set sideList {top right bottom left}
  579.     # Find those values which have been set
  580.     foreach side $sideList {
  581.         set $side 0
  582.         foreach l $tmp {
  583.             if {[string match *${side}* [lindex $l 0]]} {
  584.                 set $side 1
  585.                 set ${side}val [string trimright [lindex $l 1] "\;"]
  586.             }
  587.         }
  588.     }
  589.     # Add missing values.
  590.     foreach side $sideList {
  591.         if {![set $side]} {
  592.             switch $side {
  593.                 top {set opside bottom}
  594.                 right {set opside left}
  595.                 bottom {set opside top}
  596.                 left {set opside right}
  597.             }
  598.             if {[set $opside]} {
  599.                 set use $opside
  600.             } elseif {$top} {
  601.                 set use top
  602.             } else {
  603.                 # Can't add missing value.
  604.                 return $text
  605.             }    
  606.             append text "\;\r$indent\t[lindex $cssGroup($group) [lsearch $sideList $side]]: [set ${use}val]"
  607.         }
  608.     }
  609.     
  610.     return $text
  611. }
  612.  
  613. # Makes a short form of a group of properties.
  614. proc cssMakeShort {group text indent} {
  615.     global cssGroup
  616.     set lines [split $text \r]
  617.     set count 0
  618.     set important 0
  619.     foreach pr $cssGroup($group) {
  620.         foreach l $lines {
  621.             if {[lindex $l 0] == "$pr:"} {
  622.                 incr important [regsub { ! important} $l {} l]
  623.                 incr count
  624.                 if {$pr == "font-size"} {set fontSize 1}
  625.                 if {$pr == "font-family"} {set fontFamily 1}
  626.                 # Line-height is a special case.
  627.                 if {$pr == "line-height" && [info exists fontSize]} {
  628.                     append values /[string trimright [lrange $l 1 end] "\;"]
  629.                 } else {
  630.                     append values " " [string trimright [lrange $l 1 end] "\;"]
  631.                 }
  632.             }
  633.         }
  634.     }
  635.     if {$important > 0 && $important != $count} {return $text}
  636.     # font-size and font-family must be used for font.
  637.     if {$group == "font" && (![info exists fontSize] || ![info exists fontFamily])} {return $text}
  638.     # Remove unnecessary stuff for margin and padding and border-width.
  639.     if {$group == "margin" || $group == "padding" || $group == "border-width"} {
  640.         # If count ≠ 4, then there is no short form
  641.         if {$count != 4} {return $text}
  642.         if {[llength [removeDups $values]] == 1} {
  643.             set values " [lindex $values 0]"
  644.         } elseif {[lindex $values 0] == [lindex $values 2] && [lindex $values 1] == [lindex $values 3]} {
  645.             set values [lrange $values 0 1]
  646.         } elseif {[lindex $values 1] == [lindex $values 3]} {
  647.             set values [lrange $values 0 2]
  648.         }
  649.     }
  650.     
  651.     set text ""
  652.     if {[lindex $lines 0] == "\;"} {set text "\;"}
  653.     if {[info exists values]} {
  654.         if {$group == "font"} {set values " [removeDups $values]"}
  655.         append text "\r$indent\t$group:$values"
  656.         if {$important} {append text " ! important"}
  657.     }
  658.     return $text
  659. }
  660.  
  661. # Check if a CSS number is ok.
  662. proc cssCheckNumber {prop num unit} {
  663.     global cssPercentage cssLengths cssUnits
  664.     if {![regexp {^(-?[0-9]+\.?[0-9]*)([%a-z]*)$} $num d n u]} {
  665.         error "Invalid number."
  666.     }
  667.     if {$u != ""} {
  668.         if {[lsearch -exact [concat $cssUnits %] $u] < 0 ||
  669.         $u != "%" && [lsearch -exact $cssLengths $prop] < 0} {
  670.             error "Invalid unit."
  671.         } else {
  672.             set unit $u
  673.         }
  674.     } elseif {$unit == "No unit"} {
  675.         set unit ""
  676.     }
  677.     if {$unit == "%" && [lsearch -exact $cssPercentage $prop] < 0} {
  678.         error "Percentage not allowed."
  679.     }
  680.     return "$n$unit"
  681. }
  682.  
  683. # Check if a color number is a valid number, or one of the predefined names.
  684. # Returns 0 if not and the color number if it is.
  685. proc cssCheckColorNumber {color} {
  686.     global htmlColorName
  687.     set color [string tolower $color]
  688.     if {[info exists htmlColorName($color)]} {return $htmlColorName($color)}
  689.     # rgb(1,2,3)
  690.     if {[regexp {^rgb\(([0-9]+),([0-9]+),([0-9]+)\)$} $color dum c1 c2 c3]} {
  691.         if {$c1 > -1 && $c1 < 256 && $c2 > -1 && $c2 < 256 && $c3 > -1 && $c3 < 256} {
  692.             return $color
  693.         } else {
  694.             return 0
  695.         }
  696.     }
  697.     # rgb(1.0%,2.0%,3.0%)
  698.     if {[regexp {^rgb\(([0-9]+\.?[0-9]*)%,([0-9]+\.?[0-9]*)%,([0-9]+\.?[0-9]*)%\)$} $color dum c1 c2 c3]} {
  699.         if {$c1 >= 0.0 && $c1 <= 100.0 && $c2 >= 0.0 && $c2 <= 100.0 && $c3 >= 0.0 && $c3 <= 100.0} {
  700.             return $color
  701.         } else {
  702.             return 0
  703.         }
  704.     }
  705.         
  706.     # #123456 or #123
  707.     if {[string index $color 0] != "#"} {
  708.         set color "#${color}"
  709.     }
  710.     set color [string toupper $color]
  711.     if {([string length $color] != 7 && [string length $color] != 4) || ![regexp {^#[0-9A-F]+$} $color]} {
  712.         return 0
  713.     } else {
  714.         return $color
  715.     }    
  716. }
  717.  
  718. # Extracts the current values for the property to add.
  719. proc cssGetProperties {group} {
  720.     global cssGroup cssProperty cssAny cssURLs cssLengths cssPercentage cssColors
  721.     global htmluserColorname htmlColorNumber HTMLmodeVars cssShorthands
  722.     
  723.     upvar removePos0 remove0 removePos1 remove1 important important
  724.     upvar short short errorText errorText
  725.     
  726.     if {$group == "@import"} {return}
  727.     
  728.     # obtain all props for this group
  729.     if {[info exists cssGroup($group)]} {
  730.         set props $cssGroup($group)
  731.     } else {
  732.         set props $group
  733.     }
  734.     # Find interval to search in.
  735.     if {[catch {matchIt "\}" [getPos]} start]} {
  736.         if {![catch {search -s -f 0 -m 0 -r 0 "\}" [getPos]} r0] ||
  737.         ![catch {search -s -f 1 -i 1 -m 0 -r 0 "<STYLE([ \t\r]+[^<>]*>|>)" [getPos]} r0]} {
  738.             set start [lindex $r0 1]
  739.         } else {
  740.             set start 0
  741.         }
  742.     }
  743.     if {[catch {matchIt "\{" [getPos]} end]} {
  744.         set rbrace [maxPos]
  745.         set style [maxPos]
  746.         if {![catch {search -s -f 1 -m 0 -r 0 "\{" [getPos]} r0]} {
  747.             set rbrace [lineStart [lindex $r0 0]]
  748.         }
  749.         if {![catch {search -s -f 1 -i 1 -m 0 -r 0 "</STYLE>" [getPos]} r0]} {
  750.             set style [lindex $r0 0]
  751.         }
  752.         set end [expr $rbrace < $style ? $rbrace : $style]
  753.     }
  754.     # build a list with property values
  755.     set val {0 0}
  756.     set remove ""
  757.     # Find shorthand property
  758.     if {[lsearch -exact $cssShorthands $group] >= 0} {
  759.         if {[catch {search -s -f 1 -i 1 -m 0 -r 1 -l $end "\[ \t\r;\]+$group\[ \t\r\]*:" $start} res]} {
  760.             set groupValue ""
  761.         } elseif {![catch {search -s -f 1 -i 1 -m 0 -r 0 -l $end "\;" [lindex $res 1]} res1]} {
  762.             set groupValue [string trim [getText [lindex $res 1] [expr [lindex $res1 1] - 1]]]
  763.             lappend remove0 [lindex $res 0] 
  764.             lappend remove1 [lindex $res1 1]
  765.         } else {
  766.             set groupValue [string trim [getText [lindex $res 1] [expr $end - 1]]]
  767.             lappend remove0 [lindex $res 0]
  768.             lappend remove1 $end
  769.         }
  770.         set groupValue [string tolower $groupValue]
  771.         regsub -all {/\*[^\*]*\*/} $groupValue "" groupValue
  772.         if {[regsub {![ \t\r]*important} $groupValue {} groupValue]} {set important($group) 1}
  773.         if {$groupValue != ""} {
  774.             cssExpandProps $group $groupValue
  775.         }
  776.     }
  777.     
  778.     foreach p $props {
  779.         # Find the property
  780.         if {[catch {search -s -f 1 -i 1 -m 0 -r 1 -l $end "\[ \t\r;\]+$p\[ \t\r\]*:" $start} res]} {
  781.             if {![info exists propValue($p)]} {set propValue($p) ""}
  782.         } elseif {![catch {search -s -f 1 -i 1 -m 0 -r 0 -l $end "\;" [lindex $res 1]} res1]} {
  783.             set propValue($p) [string trim [getText [lindex $res 1] [expr [lindex $res1 1] - 1]]]
  784.             lappend remove0 [lindex $res 0] 
  785.             lappend remove1 [lindex $res1 1]
  786.             set short 0
  787.         } else {
  788.             set propValue($p) [string trim [getText [lindex $res 1] [expr $end - 1]]]
  789.             lappend remove0 [lindex $res 0]
  790.             lappend remove1 $end
  791.             set short 0
  792.         }
  793.         regsub -all {/\*[^\*]*\*/} $propValue($p) "" propValue($p)
  794.     }
  795.     foreach p $props {
  796.         set thisValue [string tolower $propValue($p)]
  797.         if {[regsub {![ \t\r]*important} $thisValue {} thisValue]} {set important($p) 1}
  798.         if {[info exists cssProperty($p)]} {
  799.             # A list of choices
  800.             set pr $cssProperty($p)
  801.             # special case with background-position and text-decoration
  802.             if {$p == "background-position" || $p == "text-decoration"} {
  803.                 set pr1 [lindex $pr 0]
  804.                 if {[llength $pr1] > 1} {
  805.                     set found 0
  806.                     for {set i 0} {$i < [llength $thisValue]} {incr i} {
  807.                         set tv [lindex $thisValue $i]
  808.                         if {[lsearch -exact $pr1 $tv] >= 0} {
  809.                             lappend val [lindex $thisValue $i]
  810.                             set thisValue [lreplace $thisValue $i $i]
  811.                             set found 1
  812.                             break
  813.                         }
  814.                     }
  815.                     if {!$found} {lappend val "No value"}
  816.                 } elseif {[set ww [lsearch -exact $thisValue $pr1]] >= 0} {
  817.                     set thisValue [lreplace $thisValue $ww $ww]
  818.                     lappend val 1
  819.                 } else {
  820.                     lappend val 0
  821.                 }
  822.                 set pr [lindex $pr 1]
  823.             }
  824.             set n 1
  825.             # four times for text-decoration and border-style
  826.             if {$p == "text-decoration" || $group == "border-style"} {set n 4}
  827.             for {set i 0} {$i < $n} {incr i} {
  828.                 if {[llength $pr] > 1} {
  829.                     if {[llength $thisValue] && [lsearch -exact $pr [lindex $thisValue 0]] >= 0} {
  830.                         lappend val [lindex $thisValue 0]
  831.                         set thisValue [lrange $thisValue 1 end]
  832.                     } else {
  833.                         lappend val "No value"
  834.                     }
  835.                 } elseif {$thisValue == $pr} {
  836.                     lappend val 1
  837.                     set thisValue ""
  838.                 } else {
  839.                     lappend val 0
  840.                 }
  841.             }
  842.         }
  843.         set l [lsearch -exact $cssLengths $p]
  844.         set pr [lsearch -exact $cssPercentage $p]
  845.         if { $l >= 0 || $pr  >= 0 } {
  846.             # Length or percentage
  847.             set n 1
  848.             # twice for background-position
  849.             if {$p == "background-position"} {set n 2}
  850.             for {set i 0} {$i < $n} {incr i} {
  851.                 if {$i < [llength $thisValue] && ![catch {cssCheckNumber $p [lindex $thisValue 0] ""} num]} {
  852.                     regexp {[0-9]+(.*)} $num dum unit
  853.                     lappend val $num $unit
  854.                     set thisValue [lrange $thisValue 1 end]
  855.                 } else {
  856.                     lappend val "" ""
  857.                 }
  858.             }
  859.         }
  860.         if {[lsearch -exact $cssAny $p] >= 0} {
  861.             # Any value
  862.             lappend val $thisValue
  863.             set thisValue ""
  864.         }
  865.         if {[lsearch -exact $cssColors $p] >=0 } {
  866.             # color
  867.             set n 1
  868.             # four times for border-color
  869.             if {$group == "border-color"} {set n 4}
  870.             for {set i 0} {$i < $n} {incr i} {
  871.                 set tv [cssCheckColorNumber [lindex $thisValue 0]]
  872.                 if {$tv == "0"} {
  873.                     lappend val "" "No value" 0
  874.                 } elseif {[info exists htmluserColorname($tv)]} {
  875.                     lappend val "" $htmluserColorname($tv) 0
  876.                 } elseif {[info exists htmlColorNumber($tv)]} {
  877.                     lappend val "" $htmlColorNumber($tv) 0
  878.                 } else {
  879.                     lappend val $tv "No value" 0
  880.                 }
  881.                 if {$tv != "0"} {set thisValue [lrange $thisValue 1 end]}
  882.             }
  883.         }
  884.         if {[lsearch -exact $cssURLs $p] >= 0} {
  885.             # URL
  886.             if {[regexp {url\(\"?([^\"\)]+)\"?\)} $thisValue dum thisValue]} {
  887.                 set thisValue [htmlURLunEscape $thisValue]
  888.                 htmlAddToCache URLs $thisValue
  889.                 lappend val "" $thisValue 0
  890.                 set thisValue ""
  891.             } else {
  892.                 lappend val "" "No value" 0
  893.             }
  894.         }
  895.         if {[llength $thisValue]} {lappend errorText "$p: $thisValue"}
  896.     }
  897.     return $val
  898. }
  899.  
  900. proc cssExpandProps {group value} {
  901.     global cssGroup cssProperty cssAny cssURLs cssLengths cssPercentage cssColors cssUnits
  902.     upvar propValue prop errorText errorText
  903.     
  904.     # Special case with font
  905.     if {$group == "font"} {
  906.         regexp {[^ \t]+(,[ \t]+[^ \t]+)*[ \t]*$} $value family
  907.         set prop(font-family) [string trim $family]
  908.         set value [string range $value 0 [expr [string length $value] - [string length $family] - 1]]
  909.         set fontsize [lindex $value [expr [llength $value] - 1]]
  910.         set lineheight ""
  911.         regexp {^([^/]+)/?(.*)$} $fontsize dum fontsize lineheight
  912.         if {[lsearch -exact $cssProperty(font-size) $fontsize] >= 0 || ![catch {cssCheckNumber font-size $fontsize ""} fontsize]} {
  913.             set prop(font-size) $fontsize
  914.         }
  915.         if {[lsearch -exact $cssProperty(line-height) $lineheight] >= 0 || ![catch {cssCheckNumber line-height $lineheight ""} lineheight]} {
  916.             set prop(line-height) $lineheight
  917.         }
  918.         set value [lrange $value 0 [expr [llength $value] - 2]]
  919.         set normal [lsearch -exact $value normal]
  920.         regsub -all "normal" $value "" value
  921.     }
  922.  
  923.     # Special case with background-position
  924.     if {$group == "background"} {
  925.         foreach bp $cssProperty(background-position) {
  926.             set nv ""
  927.             foreach v $value {
  928.                 if {[lsearch -exact $bp $v] >= 0} {
  929.                     lappend prop(background-position) $v
  930.                 } else {
  931.                     lappend nv $v
  932.                 }
  933.             }
  934.             set value $nv
  935.         }
  936.         set nv ""
  937.         foreach v $value {
  938.             if {![catch {cssCheckNumber background-position $v ""} v1]} {
  939.                 lappend prop(background-position) $v1
  940.             } else {
  941.                 lappend nv $v
  942.             }
  943.         }
  944.         set value $nv
  945.     }
  946.     
  947.     # Handle margin, padding and border-width separately
  948.     if {$group == "margin" || $group == "padding" || $group == "border-width"} {
  949.         foreach trbl {top right bottom left} {
  950.             if {$group == "border-width"} {
  951.                 set pr "border-${trbl}-width"
  952.             } else {
  953.                 set pr ${group}-$trbl
  954.             }
  955.             set v ""
  956.             if {[llength $value]} {
  957.                 set v [lindex $value 0]
  958.                 set value [lrange $value 1 end]
  959.             }
  960.             if {$group != "padding" && [lsearch -exact $cssProperty($pr) $v] >= 0} {
  961.                 set prop($pr) $v
  962.             } elseif {![catch {cssCheckNumber $pr $v ""} v1]} {
  963.                 set prop($pr) $v1
  964.             } elseif {$v != ""} {
  965.                 append err " $v"
  966.             }
  967.         }
  968.         if {[info exists err]} {lappend errorText "$group:$err"}
  969.         return
  970.     }
  971.     
  972.     # All other properties.
  973.     foreach p $cssGroup($group) {
  974.         if {[info exists cssProperty($p)]} {
  975.             set p1 $cssProperty($p)
  976.             if {$group == "font" && [lsearch -exact {font-style font-weight font-variant line-height} $p] >= 0} {
  977.                 set tmp ""
  978.                 for {set i 0} {$i < [llength $value]} {incr i} {
  979.                     set v [lindex $value $i]
  980.                     if {[lsearch -exact $p1 $v] >= 0} {
  981.                         set tmp $v
  982.                         set value [lreplace $value $i $i]
  983.                         break
  984.                     }
  985.                 }
  986.                 if {$tmp != ""} {
  987.                     set prop($p) $tmp
  988.                 } elseif {$normal >= 0} {
  989.                     set prop($p) normal
  990.                 }
  991.             } else {
  992.                 for {set i 0} {$i < [llength $value]} {incr i} {
  993.                     set v [lindex $value $i]
  994.                     if {[lsearch -exact $p1 $v] >= 0} {
  995.                         set prop($p) $v
  996.                         set value [lreplace $value $i $i]
  997.                         break
  998.                     }
  999.                 }
  1000.             }
  1001.         }
  1002.         if {[lsearch -exact $cssURLs $p] >= 0} {
  1003.             for {set i 0} {$i < [llength $value]} {incr i} {
  1004.                 set v [lindex $value $i]
  1005.                 if {[regexp {^url\(\"?[^\"\)]+\"?\)$} $v]} {
  1006.                     set prop($p) $v
  1007.                     set value [lreplace $value $i $i]
  1008.                     break
  1009.                 }
  1010.             }
  1011.         }
  1012.         if {[lsearch -exact $cssColors $p] >= 0} {
  1013.             for {set i 0} {$i < [llength $value]} {incr i} {
  1014.                 set v [lindex $value $i]
  1015.                 if {[set c [cssCheckColorNumber $v]] != "0"} {
  1016.                     set prop($p) $c
  1017.                     set value [lreplace $value $i $i]
  1018.                     break
  1019.                 }
  1020.             }
  1021.         }
  1022.         
  1023.     }
  1024.     if {[llength $value]} {lappend errorText "$group: $value"}
  1025. }
  1026.